MacHack 2001/MacHack 2001.toast/pc/The Hacks/99 Bottles hack/MyUtils/MyStrings.p

Text File | 2001-06-23 | 8.3 KB | 288 lines

unit MyStrings;

{ Useful string management functions }

interface

    uses
        AppleTalk, Processes, PPCToolbox, EPPC, Notification, AppleEvents, { All this to use the apple event manager in Convert.* ... }
        TextUtils, Resources, {}
        Assertions;

    const
        kNumbersOnly = ['0'..'9', '.', 'e', 'E', '+', '-'];
        kAutoNumDec = -99;

    function MyGetStr (resID, index, language: Integer): Str255;

    function MyReadStringLongInt (s: Str255): LongInt;
    function MyReadStringReal (s: Str255): double;

{ Substitute s1, s2, s3 and s4 for ^0, ^1, ^2 and ^3 in res }
    procedure MyParamStr (var res: Str255; s1, s2, s3, s4: Str255);

{ Convertir un réel en string approprié }
{ Passer kAutoNumDec en nbDecMax pour laisser le Mac faire la conversion }
{ Passer un nombre < 0 pour faire une conversion pour affichage à l'écran et }
{ un nombre >= 0 pour forcer le nombre de décimales exact. }
{ L'affichage à l'écran peut réduire le nombre de décimales présenté afin de ne }
{ pas présenter trop de chiffres à l'écran. Patch 23/08/99 PhC }
    function GedoubleString (val: double; nbDecMax: Integer): Str255; { nombre de décimales }
{ Une procédure d'appel à la fonction GedoubleString pour satisfaire le langage C... }
    procedure GedoubleStringProc (val: double; nbDecMax: Integer; var s: Str255);

{ Procédures permettant d'échanger entre un array de caractères et un Str255 }
    procedure MyCharHandleToString(c: Handle; var s: Str255);
    procedure MyStringToCharHandle(s: Str255; var c: Handle);

{ Fonction qui retourne le nom de la machine tel qu'entré par l'utilisateur dans le tdb Partage de Fichiers }
    function GetMachineName: Str255;

implementation

    function MyGetStr (resID, index, language: Integer): Str255;
        var
            s: Str255;
    begin
        GetIndString(s, resID + language, index);
        if ResError <> noErr then begin
            MyDebugStr('Non-localized string, OK to continue');
            GetIndString(s, resID, index);
        end;
        if ResError <> noErr then
            MyDebugStr('String not found, returning empty string');
        MyGetStr := s;
    end; { MyGetStr }

    function MyReadStringLongInt (s: Str255): LongInt;
        var
            result: LongInt;
    begin
        result := 0;
        StringToNum(s, result);
        MyReadStringLongInt := result;
    end; { MyReadStringLongInt }

{ These two functions are adapted from a tip in Nov. 98 MacTech by Stephen L. Reid }
{ <[e-mail]> to leave it to the Apple Event Manager to do all the dirty work, }
{ avoiding ReadString and eventually StringOf. ConvertDoubleToString is by SLR and }
{ ConvertStringToDouble is by PhC. }
    function ConvertDoubleToString (inValue: double; var resultStr: Str255): OSErr;
        var
            theErr: OSErr;
            outResult: AEDesc;
            l: LongInt;
    begin
        theErr := AECoercePtr(typeFloat, @inValue, Size(SizeOf(double)), typeChar, outResult); { input data type - 'doub' }
 { pointer to input data }
 { size of input data }
 { desired 'want' type is character }
 { pointer to AEDesc for output data }
        if (theErr = noErr) then begin
            l := GetHandleSize(outResult.dataHandle);
            if l > 0 then begin
                if l > 254 then
                    l := 254;
{$push}
{$R-}
                BlockMove(outResult.dataHandle^, @resultStr[1], l); { no need to hlock, this tb trap doesn't move memory! }
                resultStr[0] := Chr(l);
{$pop}
            end;
            if (noErr = AEDisposeDesc(outResult)) then
                ; { ignore error in this case }
        end;
        ConvertDoubleToString := theErr;
    end; { ConvertDoubleToString }

    function ConvertStringToDouble (inStr: Str255; var resultValue: double): OSErr;
        var
            theErr: OSErr;
            outResult: AEDesc;
            l: LongInt;
    begin
        theErr := AECoercePtr(typeChar, @inStr[1], Size(Length(inStr)), typeFloat, outResult); { input data type - character }
 { pointer to input data }
 { size of input data }
 { desired 'want' type is 'doub' }
 { pointer to AEDesc for output data }
        if (theErr = noErr) then begin
            l := GetHandleSize(outResult.dataHandle);
            if l > 0 then begin
                BlockMove(outResult.dataHandle^, @resultValue, l);
            end;
            if (noErr = AEDisposeDesc(outResult)) then
                ; { ignore error in this case }
        end;
        ConvertStringToDouble := theErr;
    end; { ConvertStringToDouble }

    function MyReadStringReal (s: Str255): double;
        var
            result: double;
            i: LongInt;
    begin
    { Added this check for non-numerics to prevent some strange crashes in the AE Manager... }
        if Length(s) > 0 then
            for i := 1 to Length(s) do
                if not (s[i] in kNumbersOnly) then { remove character at position i }
                    s[i] := ' ';
        if ConvertStringToDouble(s, result) <> noErr then
            result := -999;
        MyReadStringReal := result;
    end; { MyReadStringReal }

{$ifc false}
{ A crude procedure that would need to be localized; what it does is strip }
{ all non-numeric characters from a string and reads the result using ReadString. }
{ I can't use ReadString directly because it would crash if it encountered a non- }
{ numeric character... }
    function MyReadStringReal (s: Str255): double;
        var
            result: double;
            i: Integer;
            eCount, mantCount, expCount: Integer;
    begin
        result := 0;
        if Length(s) > 0 then begin
            for i := Length(s) downto 1 do begin
                if not (s[i] in kNumbersOnly) then begin { remove character at position i }
                    Delete(s, i, 1);
                end;
            end;
            {$ifc false}
            if Length(s) > 0 then begin { take care of e's and +/- }
                eCount := 0;
                for i := 1 to Length(s) do
                    if (s[i] in ['e', 'E']) then begin
                        eCount := eCount + 1;
                        s[i] := 'E'; { put in uppercase }
                    end;
                if eCount > 0 then begin
                    if eCount > 1 then { remove extra e's }
                        for i := Length(s) downto 1 do
                            if (s[i] in ['e', 'E']) and (eCount > 1) then begin
                                Delete(s, i, 1);
                                eCount := eCount - 1;
                            end; { if }
                    { here, eCount should be = 1. Check if there is a number before and after }
                    mantCount := 0;
                    for i := 1 to Pos('E', s) do
                        if s[i] in ['0'..'9'] then
                            mantCount := mantCount + 1;
                    expCount := 0;
                    for i := Pos('E', s) to Length(s) do
                        if s[i] in ['0'..'9'] then
                            expCount := expCount + 1;
                    if (mantCount = 0) and (expCount = 0) then { remove 'E' if no mantissa and exponent }
                        Delete(s, Pos('E', s), 1);
                end;
            end;
            {$endc}
            if Length(s) > 0 then
                ReadString(s, result);
        end;

        MyReadStringReal := result;
    end; { MyReadStringReal }
{$endc}

    procedure MyParamStr;
        procedure SubstituteParam (paramStr, subsStr: Str255);
            var
                p: Integer;
        begin
            p := Pos(paramStr, res);
            if p > 0 then
                Delete(res, p, 2);
            Insert(subsStr, res, p);
        end; { SubstituteParam }
    begin
        SubstituteParam('^3', s4);
        SubstituteParam('^2', s3);
        SubstituteParam('^1', s2);
        SubstituteParam('^0', s1);
    end; { MyParamStr }

    function GedoubleString (val: double; nbDecMax: Integer): Str255;
        var
            abv: double;
            s: Str255;
    begin
        if nbDecMax = kAutoNumDec then begin { pas de conversion demandée, utiliser le MacOS }
            if ConvertDoubleToString(val, s) <> noErr then
                s := '???';
        end
        else if nbDecMax < 0 then begin { conversion pour affichage à l'écran }
            nbDecMax := -nbDecMax;
            abv := Abs(val);
            if abv > 1e4 then
                if abv < 1E+300 then
                    s := StringOf(val)
                else begin
                    if val > 0 then
                        s := '+INF'
                    else
                        s := '-INF';
                end
            else begin
                if abv > 1e1 then
                    nbDecMax := nbDecMax - 1
                else if abv > 1e2 then
                    nbDecMax := nbDecMax - 1
                else if abv > 1e3 then
                    nbDecMax := nbDecMax - 1;
                s := StringOf(val : nbDecMax + 2 : nbDecMax);
            end; { else }
        end { else if }
        else
{$push}
{$R-}
            s := StringOf(val : nbDecMax + 2 : nbDecMax);
{$pop}

        GedoubleString := s;

    end; { GedoubleString }

    procedure GedoubleStringProc (val: double; nbDecMax: Integer; var s: Str255);
    begin
        s := GedoubleString(val, nbDecMax);
    end; { GedoubleStringProc }


    procedure MyCharHandleToString(c: Handle; var s: Str255);
    var
        l: LongInt;
    begin
        l := GetHandleSize(c);
        if (l > 254) then
            l := 254;
        BlockMoveData(c^, @s[1], l);
{$push}
{$R-}
        s[0] := Chr(l);
{$pop}
    end; { MyCharHandleToString }

    procedure MyStringToCharHandle(s: Str255; var c: Handle);
    var
        l: LongInt;
    begin
        l := Length(s);
        c := NewHandleClear(l);
        BlockMoveData(@s[1], c^, l);
    end; { MyStringToCharHandle }

    function GetMachineName: Str255;
    var
        macNameH: StringHandle;
    begin
        macNameH := GetString(-16413); { Machine name id in the System file }
        if (macNameH <> nil) then
            GetMachineName := macNameH^^
        else
            GetMachineName := '';
    end; { GetMachineName }

end. { MyStrings }